00100	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200	C *** READS DATA FROM CLEF0, BDR40,BDI40, ETC.
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00600		COMMON /DL/X22,SAVER,NAME/RRJJ/RJJ(20)
00700		DIMENSION RPOS(2,40),LST(13),DP(-3/4),LX(14),LY(7),R(8,100)
00800		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
00900		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01000		COMMON/ALF/INP(72),ML/STF/RSTFAC(-3/4),RSTJC
01050		1/POSI/STFF(-3/4),JJB,POS
01100		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
01300		COMMON/XRN/RN(4000)/DPY/ST(4000),WDS(250),MEDIT,IGO	
01400		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500		1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
01600		1,(JK,JQ(9)),(JF,JQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2)),(IT,LY(7))
01700		1,(RJC,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(LX(8),IL),(I3,INP(3))
01800		1,(RJK,RJQ(9)),(NJR,RJQJ,RJQ(8)),(SET4,RN(3920)),(R,RN(3001))
01900		1 ,(TOP,ST(3999)),(BOT,ST(4000)),(RJH,RJQ(6))
01950		1 ,(RJI,RJQ(7)),(IBEAM,RN(3000))
02000		1,(RPOS(1,1),RN(3921)),(ST2,ST(2)),(IBL,LY(1)),(RJM,RJQ(11))
02100		1,(IE,LX(4)),(IP,LX(10)),(IM,LX(9)),(II,LX(6)),(IS,LX(12))
02110		1,(LX(2),ICC),(LX(5),IG)
02200		DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
02300		1 ,LST/'NOTE','REST','CLEF','LINE','NUMB',
02400		1 'MISC','KSIG','SLUR','BEAM','STAFF','METER','TRILL','WORD'/
02500		1,DP/8*1/,LX/'A','C','D','E','G','I','J','L','M','P','R',
02600		1 'S','U','X'/
02700		1,LY/' ','A','B','D','E','F','T'/
02800	
02850	CC	RJSZ=1.
02860		LCEN=0
02870		MCEN=0
02900		TOP2=-999
03000	CC	RXGP=0
03100		I1=0
03120		DIS=1.
03140		RHT=1.
03160	C  FOR 'FILLER' ON CRT.
03300	2	CALL DPYSET(1,ST,4000)
03400		CALL TYPLOC(-200,-511)
03500		CALL DPYBRT(5)
03600		RPOS(1,1)=0
03700		PLOTIT=0
03800		RSZ=.845
03900		TOP=-999
04000		BOT=999
04100	CC	JSTF=-1
04200		X22=0
04300		JCEN=0
04400		KCEN=0
04500		PLT=0
04600		PWDS(1)=1.
04700		EDX=-1
04800		SAVER=7
04900		DO 1402 K=-3,4
05000	1402	RSTFAC(K)=1.
05100		REDIT=999.
05200		M=1
05300		ITEM=0
05400		ZERO=-1
05500		WDS(1)=4
05600	C  DATA IN DPY ARRAY STARTS AT WD.4!
05700		I=1
05800	1100	SCORE=-1
05900	CC1000	IREADX=0
06000		KNT=0
06100		CALL DPYOUT(1)
06200	CC	IF(SCORE.OR.REND)GO TO 58
06300	C   REND=-1 LAST TIME IN SCORE SECTION
06400	CC	CALL SCMSS
06500	CC	I=ISC
06600	CC	ITEM=ISITEM
06700	CC	ST2=WDS(ITEM+1)
06800	CC	CALL ACCPOG(1)
06900	CC	IF(REND.NE.100)GO TO 553
07000	C   FOR ESCAPE FROM 'SCORE' SECTION
07200	58	IGO=-1
07300		GO TO 5505
07400	
07500	
07600	11	CALL NOTWRT
07700	57	IF(PLT)GO TO 6120
07800		IF(M.LE.I.AND.IGO)CALL DPYOUT(1)
07900		IF(JA.EQ.101)GO TO 55
08000		ITEM=ITEM+1
08100		IF(IGO.GT.0)GO TO 20000
08200		K=ST2
08300		IF(X22.EQ.0)GO TO 20000
08400		CALL BOX(IBOX,RBOX,STFF)
08500		ST2=K
08600	20000	WDS(ITEM+1)=ST2
08700		IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
08800		IF(PLOTIT.EQ.-2)GO TO 2311
08900	C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
09000		PWDS(ITEM+1)=I
09100		PLT=0
09200		IF(IGO.NE.0)GO TO 55
09300		CALL DPYOUT(1)
09310		IF(SCORE.EQ.0)GO TO 9532
09355	C  GO GET MORE FROM SCX.
09400		IGO=-1
09500	
10200	CC55	IF(SCORE.EQ.0)GO TO 553
10205	55	IF(SCORE.EQ.0)GO TO 65
10210	CC55	IF(IREADX.OR.SCORE.EQ.0)GO TO 553
10300	5505	SVST=ST2
10400	C CATCHES TYPO WITH 'C'
10500		K=ITEM+1
10600		IF(X22.EQ.0)GO TO 5503
10700		K=X22
10800		L=RN(MEDIT+1)
10900		IF(L.EQ.16)L=13
11000		IF(L.EQ.18)L=11
11100		IF(L.EQ.30)L=12
11200		IF(L.EQ.11)L=0
11300	C  CHANGE CODE NUMS FOR 18 AND 30 ****************
11400		TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
11500		IF(YED.LT.2)GO TO 5500
11600	C   YED IS SET AT 426
11700	5502	DO 5501 L=4,YED+2
11800	5501	TYPE 4271,L,RN(MEDIT+L)
11900		GO TO 5500
12000	891	DEL=0
12100	C   THIS NOT USED IF DEL=0 AT LN32510 ***********
12200		GO TO 6531
12300	
12400	5503	CALL HYDPOG(3)
12500	C  TO DELETE VERTICAL LINE (55)
12600		KED=0
12700	5500	IF(DEL)GO TO 891
12800	CC	IF(IREADX)GO TO 653
12900	5504	IF(I1.EQ.IP)GO TO 2311
13000	59	TYPE 56,NAME,K,SVST
13100		JAB=JA
13200		SCORE=-1
13300		ACCEPT 89,INP
13400		DO 1313 LKX=1,14
13500	1313	IF(I1.EQ.LX(LKX))GO TO 2313
13600		LKX=0
13700	2313	LKX=LKX+1
13800	C  'SA'=SAVE; 'S'=SET; 'SB'=SAVE BIG; 'ST'=STAFF; 
13900		IF(X22.NE.0)GO TO(87,884,883,883,5313,87,884,87,883,87,59,883
14000		1,15,883,883),LKX
14100		GO TO(87,13,7555,14,5313,120,884,7555,883,7555,311,883,15,883
14200		1,59),LKX
14300	C                  A   C   D   E   G   I  J   L   M     P   R   S U(X
14400	C  HERE A=ALTER A GROUP, DE=DELETE A GROUP
14500	C  'DP'=DISPLAY OR HIDE WHICH STAVES.  D=DOWN N
14600	14	IF(I2-IE)883,13,884
14700	13	IGO=1
14800		CALL GRED
14900		IF(JA.EQ.98)GO TO 5533
15000	CC	KNT=0
15050		M=L
15075	C  GETS START POINT FROM COMMON IN 'GRED'
15100		SCORE=0
15200	CC	GO TO 65
15250		GO TO 8852
15300	15	DO 3313 LKY=1,7
15400	3313	IF(I2.EQ.LY(LKY))GO TO(312,3121,3121,3121,312,115,884),LKY
15500	C                               BL  A    B     D    E   F   T
15600	C  'SF'= SAVE AND FIXUP (I HOPE THIS IS TEMPORARY)
15700	115	CALL FIXUP
15800		GO TO 5505
15900	C  RESETS FACTORS FOR SAVE AND REDISPLAY
16000	3121	IF(X22.NE.0)GO TO 5505
16100		SAVER=7
16200		CALL SAVIT
16300		GO TO 5505
16400	312	JA=55
16500		RJB=RN(MEDIT+2)
16600		RJC=55.
16700		GO TO 6531
16800	C  ABOVE FOR 'S'ET ALIGNMENT
16900	C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
17000	C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;  'P' #S = PLOT IT
17100	5313	K=-1
17200		DO 882 JA=3,10
17300	882	IF(INP(JA).NE.IBL)GO TO 884
17400		GO TO 883
17500	885	FORMAT(A2,21F)
17600	884	REREAD 885,K,RJB,RJQ
17700		JA=55
17800		IF(I1.EQ.II)JA=22
17900		IF(I2.EQ.IT)JA=44
18000		IF(I2.NE.IP)GO TO 6531
18100		IF(RJB.GT.5)GO TO 1886
18200	C  GO BACK AND RESET ALL
18300		K=RJB
18400		JA=0
18500	C  USE '5' FOR STAFF 0.
18600	888	IF(K.EQ.5)K=0
18700		DP(K)=-DP(K)
18800		JA=JA+1
18900		K=RJQ(JA)
19000	CC***	IF(K.EQ.0)GO TO 85
19050		IF(K.EQ.0)GO TO 55
19100	C  JUMP OUT IF RJQ(JA)=0 OR 99
19150		IF(K.EQ.99)GO TO 85
19175	C*** 3/74  END WITH '99' TO MAKE DP RIGHT NOW!
19200		GO TO 888
19300	C  TO GET BACK ALL LINES TYPE 6+
19400	311	JA=0
19410		IGO=1
19500		ML=0
19600		IF(I2.NE.IL)GO TO 884
19700	1886	DO 2886 K=-3,4
19800	2886	DP(K)=1
19900		IF(I1.NE.IP)GO TO 8851
20000	C PL RESETS 'DP'
20100	C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
20200	2311	CALL PLTCMD
20300		IF(PLOTIT.EQ.0)GO TO 3005
20400		I1=IP
20500		PLOTIT=-1
20600		GO TO 6531
20700	C  'PL' GOES TO 'PLOT COMMAND' ROUTINE
20800	
20900	881	IF(I1.GT.0)GO TO 87
21000	C   JUMP IF I1 IS NOT A LETTER (K>0=NUM, K<0=LET.)
21100	883	IF(I2.EQ.IS)GO TO 2
21200	C  TYPE 'RS' TO RESTART.
21300		IF(IX.EQ.I.AND.I1.EQ.ICC)GO TO 72
21400		CALL EDIT(JJA,RJJB)
21500		GO TO 6531
21600	89	FORMAT(72A1)
21700	C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
21800	
21900	87	REREAD 1,JA,RJB,RJQ
22000		IF(K)JA=55
22100	C   ED 47 -1 = 55 47 -1, ETC.
22200		IF(JA.EQ.101)GO TO 11
22300		IF(JA.GT.0)SAVER=SAVER-1
22400		IF(SAVER.AND.X22.EQ.0)CALL SAVIT
22500	C  SAVES EVERY 7TH TIME AROUND
22610		IF(JA.EQ.14.OR.JA.EQ.144)GO TO 88
22700		IF(JA.NE.16)GO TO 6531
22710	C NEXT FOR ALPHA TEXT ITEMS.
22720		M=I
22730		CALL WORDS
22740		GO TO 8852
22750	
22800	188	RJB=0
22900	CC88	RSTJC=RSTFAC(JC+4)
22950	C ↑↑ NOW IN  SUBR. RHYTH
23000	88	SET4=RJB
23100	C  SET4 IS NEG. FOR AUTOMATIC STAFF 4 SETUP.
23110		SCORE=0
23200		IF(JA.NE.14)GO TO 889
23300	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
23400		SAVER=-1
23410		RSTF=RJC
23500		DO 1889 K=1,I
23600		J=PWDS(K)
23700		IF(RN(J+1).NE.10)GO TO 1889
23800		IF(RN(J+3).EQ.RJC)GO TO 889
23900	1889	CONTINUE
24000	C DIDN'T FIND THIS STAFF
24100		M=2000
24120		IGO=0
24200		JA=10
24300		GO TO 6531
24320	890	JA=14
24450	889	SPD=ST2
24460		JIT=ITEM
24500		ISC=I
24510		REND=0
24700	C   RETAINS ORIGINS OF SCORE SQUENCE
24800	9532	IF(REND.EQ.2)GO TO 889
24850	C  FOR READIN CONTINUATION.
24900		M=ISC
24905	9533	IF(JA.EQ.10)GO TO 890
24910		IF(REND)GO TO 9535
24955	C  REND=0 GO,   -1=NORMAL END,  1=ABORTED
25000		CALL SCMSS(M)
25100		IF(REND.EQ.1)GO TO 9535
25110		IF(REND.NE.99)GO TO 9534
25115		I=ISC
25117		GO TO 9535
25120	9534	ITEM=JIT
25130		J=M
25140	9536	ITEM=ITEM+1
25150		PWDS(ITEM)=J
25160		J=J+RN(J)+3
25170		IF(J.LT.I)GO TO 9536
25180		IF(IBEAM)GO TO 9537
25185		RJB=RSTF
25186		JA=19
25187		JC=0
25188		CALL HOMER
25190	9537	ITEM=JIT
26012		ST2=SPD
26075		GO TO 8852
26200	9535	SCORE=-1
26220		IGO=-1
26240		GO TO 5505
26260	CC	JA=19
26280	CC	RJB=RSTF
26290	CC	RJC=0
26295	CC	GO TO 6531
26300	CC553	IF(SCORE)GO TO 6531
26400	65	IGO=1
26500	C  SO DPYOUT COMES ONLY ONE PER LINE.
26600	CC653	KNT=KNT+1
26700	C   NUM OF ITEMS IN LIST
26800	CC	RJK=0
26900	CC	RJQJ=0
27000	CC	RJI=0
27100	CC64	JA=R(1,KNT)
27200	CC264	RJB=R(2,KNT)
27300	CC	IF(JA.NE.100)GO TO 550
27350	C  =100 MEANS NO MORE ITEMS.
27400	CC364	IF(REND.NE.1.)GO TO 1100
27500	C   =1 GOES BACK FOR MORE
27600	CC	KNT=0
27900	CC	GO TO 1100
28000	C  100 STOPS READER.
28100	CC550	DO 7531 K=1,6
28200	CC7531	RJQ(K)=R(K+2,KNT)
29500	6531	M=1
29600		EDX=-1
29700		IF(JA.EQ.222)GO TO 72
29800		IF(JA.EQ.2222)GO TO 73
29900		DO 5532 K=1,10
30000	5532	JQ(K)=RJQ(K)
30100		IF(JA.NE.99.AND.JA.NE.98)GO TO 7542
30200		CALL DELETE
30300		IF(JA.EQ.99)GO TO 425
30400	5533	X22=0
30500		IGO=-1
30600		CALL DPYNEW
30700		GO TO 55
30800	
30900	590	IF(PLOTIT.EQ.-1)GO TO 121
31000		I1=0
31100		GO TO 243
31200	C  GOES TO PLOTTER
31300	7542	IF(I1.EQ.IP)GO TO 590
31400	C  X22= ITEM# WHEN EDITING OR DELETING.
31500		IF(X22.NE.0)GO TO 5511
31600		IF(JA.GT.0)GO TO 155
31700		IF(RJB.NE.0)GO TO 6221
31800	C  FOR UP, DOWN, LEFT, RIGHT
31900		GO TO 5505
32000	C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
32100	155	IF(JA.EQ.24)GO TO 24
32200		IF(JA.EQ.22)GO TO 42  
32300		IF(JA.EQ.44)GO TO 44
32400		IF(JA.EQ.55)GO TO 554
32500		IF(JA.EQ.333)GO TO 6333
32600		IF(IABS(JC).GT.5.OR.(IABS(JD).GT.99.AND.JA.GT.4.AND.
32700		1 JA.NE.9.AND.JA.NE.10))GO TO 5505
32800	C  CATCHES SOME TYPO ERRORS IN P3 AND P4.(5/74: LIMIT WAS +-99)
32900	C  AVOIDS EXIT AFTER TYPO ERROR
33000		IF(JA.EQ.21.OR.JA.EQ.19)GO TO 61
33100		GO TO 60
     

00100	33	JB=RJB
00200		RJB=RJJ(JB-2)
00300		IF(JB.EQ.2)RJB=RJJB
00400		TYPE 1,JB,RJB
00500	C  TYPE 33,N TO SEE FULL CONTENTS OF PARAM. N.
00600		GO TO 5505
00700	
00800	24	IGO=0
00900		IF(X22.EQ.0)GO TO 23
01000		RJC=RHORZ(RN(MEDIT+2))
01100		M=RN(MEDIT+3)
01200		RJD=RN(MEDIT+4)*RSTFAC(M)+STFF(M)
01300		ITEM=ITEM-1
01400	C  PICKS UP POINT FROM CURSOR IN 'BOX'
01500		CALL CLRCUR
01600		X22=0
01700		GO TO 241
01800	23	IF(RJB.LT.100)GO TO 2410
01900		RJE=AMOD(RJB,100.)
02000		RJB=IFIX(RJB/100.)
02100		RJC=1000.*RJE/RJB-500.
02200		RJD=RJB*50.
02300	C TYPE 24 201 FOR 1ST HALF OF DOUBLE, 303 FOR LAST THIRD OF TRIPLE
02400	2410	IF(RJB.NE.0)GO TO 241
02500		IGO=-1
02600	243	RJB=1.
02700	C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
02800	241	RSZ=.845*RJB
02900		JCEN=RJC*RSZ
03000		KCEN=RJD*RSZ
03100	CCC↑↑↑ WAS *RSZ  ↑↑↑↑↑  11/74
06200	2312	RJB=0
06300		RJC=0
06400		RJD=0
06500	CC	TOP=-999
06600	CC	BOT=999
06700		LCEN=0
06800		MCEN=0
06900		RJSZ=1.
07000	C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
07100	85	M=1
07200		I=PWDS(ITEM+1)
07300		ITEM=0
07400	8552	ST2=3
07500	8852	PLT=1
07600		EDX=0
07700		CALL ACCPOG(1)
07800		IF(JA.NE.24.AND.JA.NE.0)IGO=0
07900		GO TO 6120
08000	
08100	6333	CALL LISTP(LST)
08200		GO TO 5505
08300	
08400	172	CALL JUGGLE
08500		CALL CLRCUR
08600		CALL DPYNEW
08700		IF(JA.EQ.22)GO TO 424
08800	C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
08900		IF(ZERO)GO TO 55
09000		X22=ZERO
09100		ZERO=-1
09200		IF(JA.EQ.55)GO TO 554
09300		IF(JA.EQ.44)GO TO 44
09400		IF(KED.NE.0)GO TO 244
09500		GO TO 425
09600	
09700	C  55,POS  -- SETS UP ALIGNMENT
09800	554	CALL BOX(-1,RJB,STFF)
09900		IF(JD.EQ.0)KED=-1
10000		RITEM=RJD
10100	C  FOR 'ED POS., STF., CODE#'
10200		IF(JC.GT.4)KED=-2
10300		RLINE=RJB
10400		RJB=RJC
10500		GO TO 45
10600	
10700	C  '22,0' EDITS LAST ITEM ENTERED
10800	42	REDIT=999.0
10900		IF(RJB.NE.0)GO TO 242
11000		X22=ITEM
11100		GO TO 429
11200	44	KED=1	
11300		RITEM=RJC
11400	C  'ST', STF#, CODE# (IF 0, ALL ITEMS COME UP)
11500	45	REDIT=RJB
11600	C  THE STAFF #
11700		JED=1
11800	244	X=ITEM  
11900		IF(JED.GT.X)GO TO 444
12000		DO 144 K=JED,X
12100		L=PWDS(K)
12200		IF(KED.EQ.-2)GO TO 654
12300	C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
12400		IF(RN(L+3).NE.REDIT)GO TO 144
12500		IF(KED)GO TO 654
12600		IF(RITEM.NE.0.AND.RITEM.NE.RN(L+1))GO TO 144
12700		IF(JA.NE.55)GO TO 344
12800	654	IF(ABS(RLINE-RN(L+2)).LT.5.0)GO TO 344
12900	144	CONTINUE
13000	444	REDIT=999.
13100	C  NO MORE ON LINE
13200		RJB=0
13300	C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
13400		GO TO 73
13500	344	JED=K+1
13600	C  FOR NEXT TIME AROUND
13700		X22=K
13800		GO TO 429
13900	C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE
14000	
14100	91	CALL ACCPOG(1)
14200		IF(I.EQ.IX)ITEM=ITEM-1
14300		GO TO 142
14400	242	IF(X22.GT.0)GO TO 5511
14500	142	IF(RJB.NE.0)GO TO 424
14600		IF(REDIT.NE.999..AND.JA.GE.0)GO TO 244
14700		X22=X22+1
14800		IF(JA)X22=X22-1+JA
14900		IF(X22.LT.1)X22=1
15000		GO TO 425
15100	427	FORMAT(1XA5/,F4.0,F7.2,F6.2,$)
15200	4271	FORMAT('+  (',I2,')',F7.2,$)
15300	
15400	C  FOR EDITING
15500	5511	IF(JA.EQ.55)GO TO 420
15600	220	IF(JA.NE.22)GO TO 720
15700	C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
15800		KED=0
15900		JED=0
16000		GO TO 72
16100	720	IF(JA.EQ.44)GO TO 420
16200		IF(JA.EQ.33)GO TO 33
16300		IF(JA.EQ.24)GO TO 24
16400	C  FOR '24' WHILE IN EDIT MODE.  MAGS WITH CURSOR AS CENTER.
16500		IF(JA.GT.13.OR.JA.EQ.1)GO TO 5505
16600	C  PARAM NUM TOO HIGH?
16700	C  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
16800	4221	IF(X22.EQ.0.OR.RJB.NE.0)GO TO 5517
16900	C  BACKS UP WHEN IN EDIT MODE.
17000	
17100		IF(JA.GT.0)GO TO 5518
17200		IF(I.EQ.IX)GO TO 91
17300		ZERO=X22+1
17400	C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
17500	72	IF(X22.EQ.0)GO TO 55
17600		IF(KED.EQ.0)REDIT=999.
17700	320	IF(I.NE.IX)GO TO 172
17800		ITEM=ITEM-1
17900	C  TO DELETE AN ITEM
18000	73	X22=0 
18100		CALL CLRCUR
18200		CALL DPYNEW
18300		IF(REDIT.EQ.999.)GO TO 441
18400		IF(JA.EQ.55)GO TO 554
18500		IF(JA.EQ.44)GO TO 44
18600	441	IF(RJB.EQ.0.OR.RJB.GT.ITEM)GO TO 55
18700	CC	GO TO 424
18800	C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
18900	424	X22=RJB
19000	425	IF(X22.GT.ITEM)GO TO 73
19100	C  LEAVES EDIT MODE.
19200	429	IX=I
19300		MEDIT=PWDS(X22)
19400		J=2
19500	426	Y=RN(MEDIT)+J
19600		CALL LOOP(0,Y,1,I,MEDIT,RN)
19700		JJA=RN(I+1)
19800		YED=Y-2
19900		L=I+2
20000		DO 422 K=1,11
20100		IF(K.GT.YED)GO TO 423
20200		RJJ(K)=RN(L+K)
20300		GO TO 422
20400	423	RJJ(K)=0
20500	422	CONTINUE
20600		RJJB=RN(L)
20700		IF(IGO.GT.0)GO TO 4231
20800	C  NO BOX WHEN IN GROUP EDIT ROUTINE
20900		IBOX=I
21000		RBOX=RJJ(1)
21100		CALL BOX(IBOX,RBOX,STFF)
21200	4231	ITEM=ITEM+1
21300		ST2=WDS(ITEM)
21400		GO TO 55
21500	
21600	5517	IF(JA.EQ.0)GO TO 6221
21700	5518	IF(JA.EQ.2)GO TO 7221
21800		IF(JA.GE.22)GO TO 55
21900		RJJ(JA-2)=RJB
22000		RJB=RJJB
22100		GO TO 6222
22200	
22300	7555	CALL MOVER
22400		IF(RJC.EQ.99)GO TO 5504
22500	C   99=BACKUP OUT OF MOVER ETC.
22600	CC8853	IF(JJB)GO TO 57
22610	8853	IF(JJB)GO TO 5505
22700		M=PWDS(JJB)
22800		I=PWDS(ITEM+1)
22900		ITEM=JJB-1
23000		ST2=WDS(JJB)
23100	C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
23200		GO TO 8852
23300	
23400	8851	IF(I1.NE.IP)GO TO 85
23500		GO TO 6531
23600	
23700	420	REDIT=0
23800	211	IF(RJB.NE.0)GO TO 320
23900		IF(KED.GE.0)RLINE=RJJB
24000		RJB=RLINE
24100	C  FOR '55' ALIGNING
24200	7221	RJJB=RJB
24300	6222	IF(JQ(1).EQ.0)GO TO 6221
24400	C  ARRAYS NEED 2O LOCATIONS HERE.
24500	C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
24600		DO 1222 K=1,20,2
24700		L=JQ(K)
24800		IF(L-2)6221,2222,3222
24900	3222	RJJ(L-2)=RJQ(K+1)
25000		GO TO 1222
25100	2222	RJJB=RJQ(K+1)
25200		RJB=RJJB
25300	1222	CONTINUE
25400	C***  LOOP SET TO 11 (20 IN ARRAY!)
25500	6221	DO 5514 K=1,11
25600		RJQ(K)=RJJ(K)
25700	5514	JQ(K)=RJQ(K)
25800		JA=JJA
25900		ITEM=ITEM-1
26000		IF(ITEM)ITEM=0
26100		ST2=WDS(ITEM+1)
26200		I=PWDS(ITEM+1)
26300		CALL DPYNEW
     

54400	60	RSTJC=RSTFAC(JC)
54500		RD=0
54510		IF(JA.NE.11)GO TO 63
54525		IF(JJ.NE.1)GO TO 62
54540		TYPE 21
54555		ACCEPT FA5,NJR
54585	C   P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
54587		LASTNM=NJR
54590	62	IF(NJR.EQ.0)NJR=LASTNM
54595	C  IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
54600	63	IF(JA.EQ.50)JA=16
54700	C  ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
54800		IF(RJB.LT.1000)GO TO 66
54900		RD=RJB
55000		IF(JA.EQ.8)RJM=RJB/1000.
55100		CALL RNOTE(RJB)
55200	C IF RJB>1000 IT FINDS TRUE RJB THROUGH NOTE NUMB.
55600	66	IF(JA.NE.16.OR.JJ.EQ.0)GO TO 160
55650	C  USE P10≠0 TO LINK UP TEXT.
55750		RJQJ=0
55810		K=ITEM
55820		IF(X22.NE.0)K=X22-1
55835		K=PWDS(K)
55850		RJB=RJE*RSTJC*RN(K+9)+RN(K+2)
55900	C  PUTS 13TH(+) LETTER IN RIGHT POS. AFTER HORIZ. MOVE.
55920	160	IF(EDX.EQ.0.OR.I1.EQ.IP)GO TO 5541
55946		RJJB=RJB
55972		JJA=JA
56000		IF(JA.EQ.1.AND.RJH.EQ.0)RJH=999.
56100	C  999=0 FOR STEM EXTENSIONS.
56200		CNT=1
56300		DO 5543 K=1,9
56400	C  10/6/73 ABOVE WAS ,11
56500		RA=RJQ(K)
56600		IF(RA.NE.0)CNT=K
56700	5543	RJJ(K)=RA
56800	C  USES ONLY 10 PARAMETERS BEYOND JA, JB
56900	2554	IF(PLT.NE.0)GO TO 5541
57000		IF(JA.EQ.9)CALL HOMER
57100		IF(JA.NE.6)GO TO 1261
57200		IF(JF.NE.0)RJM=-1
57300	
57400	1261	IF(RJM.NE.0)CALL HOMER
57500	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
57600	C **** FOR '0' EDITS ******
57700	261	RN(I)=CNT
57800		RN(I+1)=JA
57900		I=I+2
58000		RN(I)=RJB
58100		IF(RD.NE.0)RN(I)=RD
58200	C TO SAVE NOTE NUMBS IN P2.
58300		DO 4554 K=1,CNT
58400	4554	RN(I+K)=RJQ(K)
58500	3554	I=CNT+1+I
58510	5541	IF(DP(JC))GO TO 57
58520	C*** 3/74  NEW DP SYSTEM
58600	C  WHAT ABOUT EDITS?*******
58700		POS=STFF(JC)
58800		JB=ROFF(RHORZ(RJB))
58900	C  LINE IS DIVIDED INTO 200 POINTS.
59000		CENTR=POS
59100	551	IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
59200		IF(JA.EQ.7)GO TO 81
59300		IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
59400		IF(JA.EQ.18)GO TO 80
59500		IF(JA.NE.88)GO TO 116
59600		CALL NOZERO(RJB)
59700	C  USE ONLY ONE 88 CHANGE PER STAFF!!!! ********
59800		RSTFAC(JC+4)=RJB
59900	C   88,FAC,STF   SETS STAFF SIZE FACTOR(ALSO CAN BE DONE WITH 10)
60000		GO TO 57
60100	116	IF(JA.NE.16.AND.JA.NE.20)GO TO 120
60200		CALL ALPHA
60300		GO TO 57
60400	
60500	81	CALL KSIG
60600		GO TO 57
60700	
60800	80	CALL METER
60900		GO TO 57
61000	
61100	61	CALL HOMER
61200		GO TO 8853
61300	
61400	25	CALL ITMSUB
61500	C   BAR LINES, BEAMS, STAFF LINES ****
61600		GO TO 57
61700	
61800	C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY; 
61900	120	IF(I.NE.1.AND.I2.NE.IM)GO TO 5505
62000	C  'GM'=GET MORE
62100		TYPE 21
62200		ACCEPT FA5,NAME
62300		IF(NAME.EQ.'99')GO TO 5505
62400		IF(NAME.NE.IBL.AND.LOOKD(NAME).EQ.0)GO TO 120
62500	C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
62550		JA=-1
62575	C  -1 IS FOR 8852+3
62600	3005	REWIND 21
62700	C  GUARDS AGAINST LOSSAGE!
62800		PLOTIT=-1
62900		IF(I1.NE.IG)PLOTIT=-2
63000	2005	IF(NAME.EQ.IBL)GO TO 2200
63100		CALL IFILE(21,NAME)
63200	C  JUMP TO READ BIG FILES
63300	2200	J=ITEM+1
63400	2202	READ(21,END=2207),X,Y,
63500		1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
63600		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF,K
63700	CC PUT IN NEXT YEAR(12/73)1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
63710	C  BUG IN FORTRAN UNFORMATTED READ-WRITE.  SO THE CHANGE MUST WAIT.
63800	2207	IF(Y.EQ.0)GO TO 2205
63900		ITEM=ITEM+X
64000		IF(I2.EQ.IM)GO TO 2203
64100		I=Y
64200		READ(21,END=8851),RSTFAC,STFF
64300		IF(I1.EQ.IP)GO TO 6531
64400	22222	READ(21,END=8851),ST2,(ST(K),K=1,ST2+2),(WDS(K),K=1,ITEM+1)
64500		CALL DPYNEW
64600		GO TO 5505
64700	2205	TYPE 2206
64800		CALL EXIT
64900	2206	FORMAT(' **** UNPACK IT! ****')
65000	
65100	2203	RA=I-1
65200		DO 2204 K=J,J+X
65300	2204	PWDS(K)=PWDS(K)+RA
65400		GO TO 85
65500	121	IF(PLOTIT.EQ.0)GO TO 5504
65600	5121	CALL PLTSRT(M)
65700	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
65800	CC	PLT=-1-JH
65850		PLT=-1
65900	C  (JH) P8=1 OR 2 FOR 2-PASS PLOTS
66000	CC	M=I
66100	CC	I=I+M-1
66150	C M IS SET UP IN PLTSRT
66200		CALL NOZERO(RJB)
66300		DIS=RJB*1.24
66400		IF(RJC.EQ.0)RJC=RJB
66500		RHT=RJC*1.2
66600	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
66700		BOT=-BOT*RHT
66800		IF(TOP2.EQ.-999)GO TO 8121
66900		BOT=BOT+TOP2
67000		GO TO 9121
67100	8121	CALL PLOTS(K)
67200	CC	RXGP=995.-BOT
67300	9121	NOMOVE=RJF+RJG*148.*RJC
67400	C  RJF=1 FOR NO MOVE AT END.  RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
67500	CC	IXGP=JD
67600	C (JD) P4=1 FOR XGP OUTPUT
67700	CC	IF(JE.NE.0)GO TO 1122
67750		IF(JE.NE.0)GO TO 6120
67800	CC	IF(RJD.EQ.0)GO TO 6121
67810	CX	IF(RJD.NE.0)GO TO 6120
67900	CC	IF(TOP2.NE.-999)RXGP=RXGP-BOT
68000	C  MOVES 0 POINT OVER EACH TIME.
68100	CC	GO TO 1122
68200	6121	CALL PLOT(0,BOT,-3)
68300	C  MOVES PLOTTER UP IF P5=0.
68400	CC1122	X22=IXGP
68500	
68600	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
68700	6120	IF(M.GE.I)GO TO 7120
68800		CNT=RN(M)
68900	C  CLEARS INPUT ARRAY, USES ONLY 12 PARAMS.
69000		DO 6220 K=CNT+1,10
69100		JQ(K)=0
69200	6220	RJQ(K)=0
69300		JA=RN(M+1)
69400		M=M+2
69500		RJB=RN(M)
69600		DO 9120 K=1,CNT
69700		RJQ(K)=RN(M+K)
69800	9120	JQ(K)=RJQ(K)
69900		M=CNT+M+1
70000		IF(EDX.LE.0)GO TO 60
70100		GO TO 5505
70200	
70300	7120	M=1
70400		IF(EDX)GO TO 71201
70500		IF(PLT.EQ.1)EDX=-1
70600		PLT=0
70800		GO TO 5505
70900	71201	X=50*RHT
71000		TOP=TOP*RHT+X
71100		IF(NOMOVE.NE.0)TOP=0
71200		IF(NOMOVE.GT.1)TOP=NOMOVE
71310		CALL PLOT(0,TOP,3)
71400		TOP2=TOP
71500		GO TO 2
71600	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
71700	CC7121	CALL PLOT(0,TOP,3)
71800	C  MOVES PLOTTER UP
71900	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
72000	CC	TOP2=TOP
72100	CC	GO TO 2
72200	
72300	56	FORMAT(/1XA5,'  TYPE FOR ITEM #',I3,I/)
72400	1	FORMAT(I,24F)
72500	21	FORMAT(' FILE NAME?  '$)
72600		END